找传奇、传世资源到传世资源站!
VB编程 正文

vb 串口调试软件源代码

8.5玩家评分(1人评分)
下载后可评
介绍 评论 失效链接反馈

串口调试助手的源代码,可以实现数据的接收和发送;二是实现点击某个按钮发送指定数据的应用程序的源代码。代码都是含有详细的中文注释,可以直接编译通过,且内含可执行文件都是可以直接运行的。适合作为串口助手开发与原理了解的参考,希望本资源对您有用!
vb 串口调试软件源代码 VB编程-第1张VERSION 5.00Object = "{648A5603-2C6E-101B-82B6-000000000014}#1.1#0"; "MSCOMM32.OCX"Begin VB.Form Form1 Caption = "串口" ClientHeight = 5760 ClientLeft = 60 ClientTop = 450 ClientWidth = 7155 Icon = "串口.frx":0000 LinkTopic = "Form1" ScaleHeight = 5760 ScaleWidth = 7155 StartUpPosition = 3 '窗口缺省 Begin MSCommLib.MSComm MSComm1 Left = 5640 Top = 3960 _ExtentX = 1005 _ExtentY = 1005 _Version = 393216 DTREnable = -1 'True End Begin VB.CommandButton Command7 Caption = "退出" BeginProperty Font Name = "宋体" Size = 9 Charset = 134 Weight = 700 Underline = 0 'False Italic = 0 'False Strikethrough = 0 'False EndProperty Height = 495 Left = 360 TabIndex = 20 Top = 5160 Width = 735 End Begin VB.CommandButton Command6 Caption = "发送" Height = 375 Left = 1080 TabIndex = 19 Top = 4680 Width = 615 End Begin VB.TextBox Text2 Height = 1335 Left = 1680 MultiLine = -1 'True TabIndex = 18 Top = 4200 Width = 5415 End Begin VB.CommandButton Command5 Caption = "清空重填" Height = 375 Left = 0 TabIndex = 15 Top = 4320 Width = 1095 End Begin VB.CommandButton Command4 Caption = "保存显示数据" Height = 375 Left = 0 TabIndex = 13 Top = 3360 Width = 1335 End Begin VB.CommandButton Command3 Caption = "停止显示" Height = 375 Left = 0 TabIndex = 12 Top = 2640 Width = 1095 End Begin VB.CommandButton Command2 Caption = "清空接收区" Height = 375 Left = 0 TabIndex = 11 Top = 2160 Width = 1095 End Begin VB.TextBox Text1 Height = 3855 Left = 1680 MultiLine = -1 'True TabIndex = 10 Top = 240 Width = 5415 End Begin VB.CommandButton Command1 Caption = "关闭串口" Height = 375 Left = 600 TabIndex = 9 Top = 1680 Width = 1095 End Begin VB.OptionButton Option1 BackColor = &H000000FF& Height = 255 Left = 240 TabIndex = 8 Top = 1680 Value = -1 'True Width = 255 End Begin VB.ComboBox Combo4 Height = 300 ItemData = "串口.frx":030A Left = 840 List = "串口.frx":0314 TabIndex = 7 Text = " 1" Top = 1320 Width = 855 End Begin VB.ComboBox Combo3 Height = 300 ItemData = "串口.frx":0320 Left = 840 List = "串口.frx":032D TabIndex = 5 Text = " 8" Top = 960 Width = 855 End Begin VB.ComboBox Combo2 Height = 300 ItemData = "串口.frx":033D Left = 840 List = "串口.frx":0362 TabIndex = 3 Text = "9600" Top = 600 Width = 855 End Begin VB.ComboBox Combo1 Height = 300 ItemData = "串口.frx":03AC Left = 840 List = "串口.frx":03BC TabIndex = 1 Text = "COM1" Top = 240 Width = 855 End Begin VB.Label Label9 Caption = "十六进制" Height = 255 Left = 240 TabIndex = 22 Top = 3120 Width = 855 End Begin VB.Label Label8 Caption = "十六进制" Height = 255 Left = 240 TabIndex = 21 Top = 4800 Width = 855 End Begin VB.Label Label7 BorderStyle = 1 'Fixed Single Caption = "发送区" Height = 255 Left = 1080 TabIndex = 17 Top = 4320 Width = 615 End Begin VB.Label Label6 Caption = "C:\COMDATA" Height = 255 Left = 120 TabIndex = 16 Top = 3840 Width = 1215 End Begin VB.Label Label5 BorderStyle = 1 'Fixed Single Caption = "接收区" Height = 255 Left = 1080 TabIndex = 14 Top = 2400 Width = 615 End Begin VB.Label Label4 Caption = "停止位" Height = 255 Left = 240 TabIndex = 6 Top = 1320 Width = 615 End Begin VB.Label Label3 Caption = "数据位" Height = 255 Left = 240 TabIndex = 4 Top = 960 Width = 735 End Begin VB.Label Label2 Caption = "波特率" Height = 255 Left = 240 TabIndex = 2 Top = 600 Width = 615 End Begin VB.Label Label1 Caption = "串口" Height = 255 Left = 360 TabIndex = 0 Top = 240 Width = 495 EndEndAttribute VB_Name = "Form1"Attribute VB_GlobalNameSpace = FalseAttribute VB_Creatable = FalseAttribute VB_PredeclaredId = TrueAttribute VB_Exposed = FalseOption ExplicitOption Base 1'Download by http://www.codefans.netPrivate Declare Sub Sleep Lib "kernel32" (ByVal dwMilliseconds As Long)Dim comport As ByteDim rate As LongDim data_cnt As IntegerDim stop_cnt As IntegerDim disp_on As Integer'Dim mut As BooleanDim bMSCommOpen As Boolean '串口打开标志Private Sub com_change()Dim flag As BooleanOn Error Resume NextErr.ClearIf bMSCommOpen = False Then Exit Sub '初始化完成前本过程无效flag = MSComm1.PortOpenIf flag Then MSComm1.PortOpen = False '已打开先关闭MSComm1.CommPort = comport '设置串行端口MSComm1.Settings = CStr(rate) ",N," CStr(data_cnt) "," CStr(stop_cnt) '设置波特率及数据帧格式MSComm1.PortOpen = TrueIf Err.Number ThenIf Err.Number = 8002 Then MsgBox "串口" CStr(comport) "不存在!", vbOKOnly, "警告"If Err.Number = 8005 Then MsgBox "串口" CStr(comport) "已打开!", vbOKOnly, "警告"Option1.BackColor = RGB(0, 0, 0)Command1.Enabled = FalseCommand6.Enabled = FalseErr.ClearElse Option1.BackColor = RGB(255, 0, 0) Command1.Enabled = True Command1.Caption = "关闭串口" Command6.Enabled = TrueEnd IfEnd SubPrivate Sub Combo1_click()comport = Combo1.ListIndex 1com_changeEnd SubPrivate Sub Combo2_click()Select Case Combo2.ListIndex Case 0 rate = 300 Case 1 rate = 600 Case 2 rate = 1200 Case 3 rate = 2400 Case 4 rate = 4800 Case 5 rate = 9600 Case 6 rate = 19200 Case 7 rate = 38400 Case 8 rate = 56000 Case 9 rate = 57600 Case 10 rate = 115200End Selectcom_changeEnd SubPrivate Sub Combo3_click()data_cnt = 8 - Combo3.ListIndexcom_changeEnd SubPrivate Sub Combo4_click()stop_cnt = 1 Combo4.ListIndexcom_changeEnd SubPrivate Sub Command1_Click()If Command1.Caption = "关闭串口" ThenMSComm1.PortOpen = FalseCommand1.Caption = "打开串口"Option1.BackColor = RGB(0, 0, 0)ElseMSComm1.PortOpen = TrueCommand1.Caption = "关闭串口"Option1.BackColor = RGB(255, 0, 0)End IfEnd SubPrivate Sub Command2_Click()Text1.Text = ""End SubPrivate Sub Command3_Click()Static f2 As ByteIf f2 = 0 Thendisp_on = 0f2 = 1Command3.Caption = "继续显示"Elsedisp_on = 0f2 = 0Command3.Caption = "停止显示"End IfEnd SubPrivate Sub Command4_Click()Dim time As Datetime = Now()Open "c:\comdata.txt" For Output As #5Print #5, timePrint #5, Text1.TextClose #5End SubPrivate Sub Command5_Click()Text2.Text = ""End SubPublic Function IsHex(c As String) As IntegerIf c >= "0" And c <= "9" Then IsHex = Val(c) - Val("0")ElseIf c >= "a" And c <= "f" Then IsHex = Asc(c) - Asc("a") 10ElseIf c >= "A" And c <= "F" Then IsHex = Asc(c) - Asc("A") 10Else IsHex = 16End IfEnd FunctionPrivate Sub Command6_Click()'Dim s As String'Dim l As Integer'Dim i As Integer, j As Integer, cnt As Integer'Dim a As Integer''Dim send_buf() As Byte''ReDim send_buf(1024)''cnt = 0's = Trim(Text2.Text)'l = Len(s)'Do While (l)' Do Until IsHex(Left(s, 1)) <> 16' l = l - 1' If l = 0 Then Exit Do' s = Right(s, l)' Loop' a = IsHex(Left(s, 1))'' l = l - 1' s = Right(s, l)'' If l <> 0 And IsHex(Left(s, 1)) <> 16 Then' a = a * 16 IsHex(Left(s, 1))' l = l - 1' s = Right(s, l)' End If' cnt = cnt 1' send_buf(cnt) = a'Loop''If cnt > 128 Then cnt = 128'ReDim Preserve send_buf(cnt)MSComm1.Output = "?" 'send_buf()MSComm1.Output = vbCrEnd SubPrivate Sub Command7_Click()Unload MeEnd SubPrivate Sub Form_Activate()On Error Resume NextbMSCommOpen = FalseCombo1.ListIndex = 3Combo2.ListIndex = 10Combo3.ListIndex = 0Combo4.ListIndex = 0bMSCommOpen = TrueMSComm1.PortOpen = TrueIf Err.Number ThenMsgBox "串口1已打开!", vbOKOnly, "警告"Option1.BackColor = RGB(0, 0, 0)Command1.Enabled = FalseCommand6.Enabled = FalseErr.ClearEnd If'Command1.SetFocusEnd SubPrivate Sub Form_Load()MSComm1.CommPort = 1 '设置串行端口com1MSComm1.Settings = "9600,N,8,1" '设置波特率及数据帧格式MSComm1.InputLen = 0 '读取接收缓冲区的所有字符MSComm1.InBufferSize = 4000 '数据接受缓冲区大小为4000字节MSComm1.OutBufferSize = 4000 '数据发送缓冲区大小为4000字节MSComm1.RThreshold = 1 '每10位数据到接收缓冲区都触发接收事件MSComm1.SThreshold = 1 '发送缓冲区空触发发送事件MSComm1.InputMode = comInputModeText '字节模式'MSComm1.InputMode = comInputModeBinary'设定 InputMode 以读取二进位资料disp_on = 1comport = 1rate = 9600data_cnt = 8stop_cnt = 1End SubPrivate Sub MSComm1_OnComm()Static cnt As IntegerDim receive_cnt As IntegerDim i As IntegerDim Buffer As VariantDim Arr() As ByteDim s As String'Select Case MSComm1.CommEvent'Case comEvReceive'receive_cnt = MSComm1.InBufferCount '接收缓冲区的字节数' 往暂存区存二进位资料'Buffer = MSComm1.Input' 指定给位元组阵列以便处理'Arr = Buffer''s = ""'For i = 0 To receive_cnt - 1''If Arr(i) > 15 Then's = s Hex(Arr(i)) " "'Else's = s "0" Hex(Arr(i)) " "'End If''cnt = cnt 1''Next iText1.Text = MSComm1.Input 'Text1.Text & s'If cnt >= 300 Then' Text1.Text = ""' cnt = 0' Exit Sub'End If'Case comEvSend''End SelectEnd Sub

评论

发表评论必须先登陆, 您可以 登陆 或者 注册新账号 !


在线咨询: 问题反馈
客服QQ:174666394

有问题请留言,看到后及时答复